home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / CALTODAY.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-30  |  6.6 KB  |  243 lines
  1. 10  'CALTODAY - 28 APR 89 rev. 30 DEC 97
  2. 20  'Adapted from "How to Program Your IBM PC", by Carl Shipman
  3. 30  'Published by Knight-Ridder Press        ISBN:0-89586-544-0
  4. 40  'Library of Congress Catalog No. 83-81692
  5. 50  '
  6. 60  IF EX$=""THEN EX$="EXIT"
  7. 70  COMMON EX$
  8. 80  CLS:KEY OFF
  9. 90  COLOR 7,0,1
  10. 100  '
  11. 110  DIM LKUP$(12,2)
  12. 120  UL$=STRING$(80,205)
  13. 130  RESTORE
  14. 140  DATA JANUARY,31,FEBRUARY,28,MARCH,31,APRIL,30,MAY,31,JUNE,30
  15. 150  DATA JULY,31,AUGUST,31,SEPTEMBER,30,OCTOBER,31,NOVEMBER,30,DECEMBER,31
  16. 160  FOR J=1 TO 12:FOR K=1 TO 2
  17. 170  READ LKUP$(J,K)
  18. 180  NEXT K:NEXT J
  19. 190  '
  20. 200  LIN=-11                      'base line no.
  21. 210   FOR ABC=1 TO 3
  22. 220  IF ABC=1 THEN MGN=24         'left margin - this month
  23. 230  IF ABC=2 THEN MGN=4          'left margin - last month
  24. 240  IF ABC=3 THEN MGN=44         'left margin - next month
  25. 250  Z$=DATE$                     'current date
  26. 260  '
  27. 270  MNUM%=VAL(LEFT$(DATE$,2))    'current month no.
  28. 280  IF ABC=1 THEN 320
  29. 290  IF ABC=2 THEN MNUM%=MNUM%-1  'last month no.
  30. 300  IF ABC=3 THEN MNUM%=MNUM%+1  'next month no.
  31. 310  '
  32. 320  DAY%=VAL(MID$(DATE$,4,2))    'current day no.
  33. 330  IF ABC=2 THEN DAY%=1
  34. 340  '
  35. 350  Y#=VAL(RIGHT$(DATE$,4))      'current year no.
  36. 360  IF MNUM%>12 THEN MNUM%=1:Y#=Y#+1   'next month no. next year
  37. 370  IF MNUM%<1 THEN MNUM%=12:Y#=Y#-1   'last month no. last year
  38. 380  IF Q$<>""THEN 620
  39. 390  '
  40. 400  '.....start
  41. 410  PRINT " Press number in < > for:
  42. 420  PRINT UL$;
  43. 430  PRINT "  < 1 >  Current 3 months"
  44. 440  PRINT "  < 2 >  Any month of any year after 1752"
  45. 450  PRINT "  < 3 >  12 month calendar for any year after 1752"
  46. 460  PRINT "  < 4 >  Count days between dates"
  47. 470  PRINT UL$;
  48. 480  PRINT "  < 0 >  EXIT"
  49. 490  Q$=INKEY$
  50. 500  IF Q$="0"THEN CLS:RUN EX$
  51. 510  IF Q$="1"THEN CLS:GOTO 620
  52. 520  IF Q$="2"THEN CLS:GOTO 570
  53. 530  IF Q$="3"THEN CLS:GOTO 1410
  54. 540  IF Q$="4"THEN CLS:CHAIN"DAYS"
  55. 550  GOTO 490
  56. 560  '
  57. 570  INPUT " ENTER: Year.............";Y#
  58. 580  IF Y#<1753 THEN 2210
  59. 590  INPUT " ENTER: Month number.....";MNUM%
  60. 600  CLS
  61. 610  '
  62. 620  '.....look up data
  63. 630  COLOR 7,0,0
  64. 640  M$=LKUP$(MNUM%,1)            'month name
  65. 650  MY$=M$+STR$(Y#)              'month, year
  66. 660  ND%=VAL(LKUP$(MNUM%,2))      'number of days in month
  67. 670  '
  68. 680  '....calculate calendar
  69. 690  FLEAP%=0                             'flag
  70. 700  IF Y# MOD 400=0 THEN 730             'leap year
  71. 710  IF Y# MOD 100=0 THEN 750             'not leap year
  72. 720  IF Y# MOD 4<>0  THEN 750             'not leap year
  73. 730  FLEAP%=1:IF ND%=28 THEN ND%=29       'add day to Feb.if leap year
  74. 740  '....get days in prior years
  75. 750  YDAYS=365*Y#+INT((Y#-1)/4)-INT(0.75*(INT((Y#-1)/100)+1))
  76. 760  '....add days in prior months this year
  77. 770  MDAYS=0
  78. 780  FOR I=1 TO MNUM%-1:MDAYS=MDAYS+VAL(LKUP$(I,2)):NEXT I
  79. 790  '....add 1st day, this month
  80. 800  DAYS=YDAYS+MDAYS+1
  81. 810  '....if leap year add leap day
  82. 820  IF FLEAP%=1 AND MNUM%>2 THEN DAYS=DAYS+1
  83. 830  DW%=DAYS+INT(-DAYS/7)*7+6:            'calculate dayweek factor
  84. 840  '
  85. 850  '....display calendar
  86. 860  IF ABC=3 THEN LIN=1
  87. 870  LIN=LIN+12
  88. 880  COLOR 0,7
  89. 890  LOCATE LIN,MGN-1
  90. 900  PRINT CHR$(221);                  'left border
  91. 910  LOCATE LIN,MGN
  92. 920  PRINT SPC(35);CHR$(222)           'background & right border
  93. 930  T=INT((35-LEN(MY$))/2)
  94. 940  LOCATE LIN,MGN+T
  95. 950  PRINT MY$
  96. 960  LOCATE LIN+1,MGN-1
  97. 970  COLOR 0,7:PRINT CHR$(221);        'left border
  98. 980  COLOR 10,12
  99. 990  PRINT " SUN  MON  TUE  WED  THU  FRI  SAT ";
  100. 1000  COLOR 0,7:PRINT CHR$(222)         'right border
  101. 1010  CS%=1                             'counts spaces
  102. 1020  '
  103. 1030  '.....blank background
  104. 1040  FOR Z=LIN+2 TO LIN+8
  105. 1050  LOCATE Z,MGN-1:COLOR 0,7:PRINT CHR$(221);
  106. 1060  COLOR 0,6:PRINT SPC(35);
  107. 1070  COLOR 0,7:PRINT CHR$(222)
  108. 1080  NEXT Z
  109. 1090  '
  110. 1100  '.....print days
  111. 1110  FOR R%=LIN+2 TO LIN+8             'row
  112. 1120  FOR C%=1 TO 31 STEP 5             'column
  113. 1130  CD%=CS%-DW%
  114. 1140  IF ABC=2 OR ABC=3 THEN 1170
  115. 1150  IF Q$="2"THEN COLOR 15,6:GOTO 1170
  116. 1160  IF CD%=DAY% THEN COLOR 15,3 ELSE COLOR 15,6   'hi-lite today's date
  117. 1170  '....CD%=dates, ND%=days in month
  118. 1180  IF CD%<1 OR CD%>ND% THEN 1240     'bad dates
  119. 1190  CD$=STR$(CD%)
  120. 1200  IF LEN(CD$)<3 THEN CD$=" "+CD$
  121. 1210  CD$=CD$+" "
  122. 1220  IF ABC=2 OR ABC=3 THEN COLOR 15,6
  123. 1230  LOCATE R%,C%+MGN:PRINT CD$
  124. 1240  CS%=CS%+1
  125. 1250  NEXT C%
  126. 1260  NEXT R%
  127. 1270  COLOR 0,7
  128. 1280  LOCATE LIN+8,MGN-1
  129. 1290  PRINT CHR$(221);                  'left border
  130. 1300  PRINT SPC(35);CHR$(222)           'background & right border
  131. 1310  IF Q$="2"THEN COLOR 7,0:GOTO 1390      'single month display
  132. 1320  IF ABC=1 THEN MO$="THIS"
  133. 1330  IF ABC=2 THEN MO$="LAST"
  134. 1340  IF ABC=3 THEN MO$="NEXT"
  135. 1350  LOCATE CSRLIN-1,MGN+13
  136. 1360  PRINT MO$;" MONTH"
  137. 1370  COLOR 7,0
  138. 1380  NEXT ABC
  139. 1390  GOTO 2180                         'screen dump
  140. 1400  '
  141. 1410  '.....12 month calendar
  142. 1420  CLS
  143. 1430  INPUT " ENTER: Year (yyyy).........";Y$
  144. 1440  IF VAL(Y$)<1753 THEN 2210
  145. 1450  IF LEN(Y$)<>4 THEN 1430
  146. 1460  Y%=VAL(Y$)
  147. 1470  CLS
  148. 1480  '
  149. 1490  '....calculate calendar
  150. 1500  FOR MON=1 TO 12:MNUM%=MON            'month number
  151. 1510  M$=LKUP$(MNUM%,1)                    'month name
  152. 1520  MY$=M$+STR$(Y%)                      'month, year
  153. 1530  ND%=VAL(LKUP$(MNUM%,2))              'number of days in month
  154. 1540  FLEAP%=0:                            'flag
  155. 1550  IF Y% MOD 400=0 THEN 1580             'leap year
  156. 1560  IF Y% MOD 100=0 THEN 1610             'not leap year
  157. 1570  IF Y% MOD 4<>0  THEN 1610             'not leap year
  158. 1580  FLEAP%=1: IF ND%=28 THEN ND%=29      'add day to Feb.if leap year
  159. 1590  '
  160. 1600  '....get days in prior years
  161. 1610     YDAYS=365*Y%+INT((Y%-1)/4)-INT(0.75*(INT((Y%-1)/100)+1))
  162. 1620  '
  163. 1630  '....add days in prior months this year
  164. 1640     MDAYS=0
  165. 1650      FOR I=1 TO MNUM%-1
  166. 1660       MDAYS=MDAYS+VAL(LKUP$(I,2))
  167. 1670      NEXT I
  168. 1680  '
  169. 1690  '....add 1st day, this month
  170. 1700     DAYS=YDAYS+MDAYS+1
  171. 1710  '
  172. 1720  '....if leap year add leap day
  173. 1730     IF FLEAP%=1 AND MNUM%>2 THEN DAYS=DAYS+1
  174. 1740     DW%=DAYS+INT(-DAYS/7)*7+6:            'calculate dayweek factor
  175. 1750  '
  176. 1760  '....display calendar
  177. 1770  DATA 1,5,1,30,1,55
  178. 1780  DATA 9,5,9,30,9,55
  179. 1790  DATA 17,5,17,30,17,55
  180. 1800  DATA 1,5,1,30,1,55
  181. 1810  READ LIN,COL
  182. 1820  COLOR 0,7
  183. 1830  LOCATE LIN,COL
  184. 1840  PRINT SPC(22)
  185. 1850  T=INT((22-LEN(MY$))/2)
  186. 1860  LOCATE LIN,COL+T
  187. 1870  PRINT MY$
  188. 1880  COLOR 10,12
  189. 1890  LOCATE LIN+1,COL
  190. 1900  PRINT " SU MO TU WE TH FR SA ";
  191. 1910  CS%=1                             'counts spaces
  192. 1920  '
  193. 1930  COLOR 0,1
  194. 1940   FOR BGC=2 TO 7
  195. 1950    LOCATE LIN+BGC,COL
  196. 1960    PRINT SPC(22)         'B/G colour
  197. 1970   NEXT BGC
  198. 1980  '
  199. 1990  FOR R%=LIN+2 TO LIN+8
  200. 2000   FOR C%=COL+1 TO COL+21 STEP 3    'column
  201. 2010   CD%=CS%-DW%
  202. 2020   '.....CD%=DATES, ND%=DAYS IN MONTH
  203. 2030   IF CD%<1 OR CD%>ND% THEN 2100    'bad dates
  204. 2040   CD$=STR$(CD%)
  205. 2050   CD$=RIGHT$(CD$,LEN(CD$)-1)       'remove blank space
  206. 2060   IF LEN(CD$)<2 THEN CD$=" "+CD$
  207. 2070   LOCATE R%,C%
  208. 2080   COLOR 15,1
  209. 2090   PRINT CD$;
  210. 2100   CS%=CS%+1
  211. 2110   NEXT C%
  212. 2120  LN=LN+1
  213. 2130  IF LN=63 THEN COLOR 7,0:GOSUB 2300:CLS:LN=0:GOTO 2140
  214. 2140  NEXT R%
  215. 2150  COLOR 7,0:NEXT MON
  216. 2160  GOTO 2180
  217. 2170  '
  218. 2180  '.....end
  219. 2190  GOSUB 2300:CLS:Q$="":GOTO 200
  220. 2200  '
  221. 2210  '.....year before 1753
  222. 2220  BEEP:PRINT
  223. 2230  PRINT " Cannot calculate years earlier than 1753,"
  224. 2240  PRINT " when the Georgian Calendar was adopted."
  225. 2250  PRINT
  226. 2260  PRINT " Press any key to start over......."
  227. 2270  IF INKEY$=""THEN 2270
  228. 2280  CLS:GOTO 200
  229. 2290  '
  230. 2300  'HARDCOPY
  231. 2310  GOSUB 2420:LOCATE 25,2:COLOR 14,6
  232. 2320  PRINT " Press 1 to print screen, 2 to print screen & ";
  233. 2330  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  234. 2340  Z$=INKEY$:IF Z$="3"THEN GOSUB 2420:RETURN
  235. 2350  IF Z$="1"OR Z$="2"THEN GOSUB 2420:GOTO 2370
  236. 2360  GOTO 2340
  237. 2370  FOR QX=1 TO 24:FOR QY=1 TO 80
  238. 2380  LPRINT CHR$(SCREEN(QX,QY));
  239. 2390  NEXT QY:NEXT QX
  240. 2400  IF Z$="2"THEN LPRINT CHR$(12)
  241. 2410  GOTO 2310
  242. 2420  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  243.